;CWL:<403-TCP>TCPJS.MAC.40303 29-Apr-82  7:56:33, Edit by CLYNN
; Work on packetizing
;<403-TCP>TCPJS.MAC.40301 29-Jan-82 15:03:44, Edit by CLYNN
; Updated for TCP release 3, STAT functions added: symbolic, TVT, conn
; MAXSTO moved to STG as TCPPTM
;[BBNF]<401-TCP>TCPJS.MAC.153, 10-Jul-81 12:32:00, Ed: CLYNN
; Fix: wait bit usage in MAKBFR & FREBFR
;<401-TCP>TCPJS.MAC.148,  4-Apr-81 17:18:53, Edit by TAPPAN
; Put multinet stuff in master file under a conditional

	SEARCH	INPAR,TCPPAR,PROLOG
IFN MNET,<
	SEARCH	MNTPAR
>
	TTITLE	TCPJS
	SUBTTL	TCP JSYS Service Routines, William W. Plummer, 25FEB77
	SWAPCD
COMMENT	!

	This file contains the routines which service user
	calls on the TCP.  Executed in non-Job0 process context.

* .SEND ...  3 ...... SEND JSYS
  SEND1 ...  4 ...... SEND, second phase
  SETURG ..  7 ...... Set send urgent pointer
* .RECV ...  8 ...... RECV JSYS
  RECV1 ...  9 ...... RECV, second phase
* .OPEN ... 11 ...... OPEN JSYS
  OPEN1 ... 12 ...... OPEN, second phase
* .CLOSE .. 14 ...... CLOSE JSYS
* CLOSE1 .. 15 ...... CLOSE, second phase
* .ABORT .. 16 ...... ABORT JSYS
  ABORT1 .. 16 ...... ABORT, second phase
* ABTJCS .. 17 ...... Abort JCNs for fork and inferiors
  ABTJC1 .. 17 ...... Second phase of above
  ABTJCN .. 18 ...... Abort a JCN
* ABTTCB .. 19 ...... Abort a connection
  ABTPTR .. 20 ...... ADJBP simulation for ABTTCB
* TCPABT .. 20 ...... ABORT done test for scheduler
* .STAT ... 21 ...... STAT JSYS
  STATS ... 22 ...... STAT, return TCP statistics
  STAT1 ... 23 ...... STAT, second phase
  STATNM .. 24 ...... STAT, from symbolic input
  SRCH .... 25 ...... STAT, Binary lookup routine for STATNM
            26 ...... STAT, tables of names, counts, and byte pointers
* .CHANL .. 27 ...... CHANL JSYS
  CHANL1 .. 28 ...... CHANL, second phase
* .SCSLV .. 29 ...... SCSLV JSYS
  SCSLV1 .. 29 ...... SCSLV, second phase
* TATNVT .. 30 ...... TVT portion of ATNVT JSYS
  TATNV1 .. 31 ...... ATNVT, second phase

  ACTTCB .. 33 ...... Activate a connection
  CHKARG .. 35 ...... Check arguments to a TCP JSYS
  CHKJCN .. 39 ...... Check validity of a JCN
  GETJCN .. 39 ...... Assign a JCN
  RETJCN .. 40 ...... Release a JCN
  MAKBFR .. 41 ...... Form a buffer descriptor block
  FREBFR .. 44 ...... Release resources used by a buffer
	!
STSFLG==TCP%IX!TCP%NI!TCP%NT!TCP%SD!TCP%ST!TCP%SY!TCP%TV ; Frequent constant

; .SEND		Send a buffer

;T1/	Flags,,JCN (or Pointer to Connection Descriptor)
;T2/	Pointer to buffer header
;T3/	Timeout (in seconds) (0 is infinite)
;T4/	RX parameters
;
;	SEND
;Ret+1:	 Error, Code in T1
;Ret+2:	Success

.SEND::	MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT>&↑-<TCP%JS!TCP%WT!TCP%HP>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,SEND1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call SEND1
	JUMPL T1,TCPERR		; Error.
	UMOVE T1,T1		; Get the Flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
	  JRST SKMRTN		; No.  Give immediate skip return
SENDW:	LOAD T1,BIDX,(BFR)	; Buffer Done Flag Index
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,↑D18+<WID(TERRF)> ; Build bfr,err,,INTOOT
	HRRI T1,INTOOT		; Select SEND Done Test routine
	MDISMS			; Wait for either to come on
	JN TERR,(TCB),TCPBER	; Jump if there was an error
	JN TSUOP,(TCB),TCPSKP	; That's all if connection open
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,↑D18+<WID(TERRF)> ; Build opn,err,,INTZOT
	HRRI T1,INTZOT		; Select Close Done Test
	MDISMS
	JE TERR,(TCB),TCPSKP

TCPBER:	CALL FREBFR		; Release resources used in buffer
	LOAD T1,TERR,(TCB)	; Pick up the error code

TCPERR:	ANDI T1,-1		; Save just the error code
TCPERO:	UMOVEM T1,T1		; Pass to user
	RETERR			; Give no-skip return

TCPILP:	HRROI T1,ELP+↑D1	; Illegal parameter (control bit)
	JRST TCPERR

TCPSKP:	CALL FREBFR		; Release resources
	SMRETN			; And give skip return

; SEND1(TCB)		Second phase of SEND

;T1/	JCN specified by caller
;TCB/	(Extended) Pointer to locked connection block
;			NOINT
;	CALL SEND1
;Ret+1:	Always, T1 has 0 and BFR has the buffer, or T1 has -1,,error

SEND1:	JN TTVT,(TCB),SEND8	; Not allowed for TVTs
	LOAD T3,TSSYN,(TCB)
	CAIE T3,NOTSYN
	CAIN T3,FINSNT		; Closed or closing?
	  JRST SEND6		; Give error
	SETZ T2,		; Not allow options from CDB here
	CALL ACTTCB		; Try to activate the TCB (JCN in T1)
	JUMPL T1,SEND6		; Can't

	XCTU [HRRZ T2,2]	; Get user buffer header address
	SETZ T1,
	JE TNUFM,(TCB),SEND3	; Skip if old format
	UMOVE T1,.TCPBI(T2)	; Get IP info
	UMOVE T2,.TCPBO(T2)	; Get user option addresses word
	TRNE T1,777		; Specified?
	  STOR T1,TTOS,(TCB)	; Yes, Save type of service
	HLRS T1
	TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
	  STOR T1,TTTL,(TCB)	; Yes, Save Time to live
	LSH T1,↑D<-18+2>	; Top two bits
	TRNE T1,3
	  STOR T1,TIFDF,(TCB)	; Don't fragment

	MOVE T1,T2		; Option addresses
SEND3:
; Should options be synchronous or asynchronous??
	SKIPE T1		; Have options?
	 CALL TCPUOP		; Yes
	  JUMPL T1,SENDX	; Error in options

	CALL MAKBFR		; Make a buffer descriptor
	SKIPGE BFR,T1		; Error?
	  EXIT SENDX		; Yes.  Code in T1.

	UMOVE T3,T3		; Get the Send Timeout from user
	JUMPE T3,SEND4		; He says infinite.  Don't set it.
	CAMLE T3,TCPPTM		; Be sure it is reasonable for add to TODCLK
	   MOVE T3,TCPPTM
	IMULI T3,↑D1000		; Convert to milliseconds
	STOR T3,TSTO,(TCB)	; Set new value in TCB
SEND4:

	UMOVE T1,T4		; Get Retrans. parameter word
	CALL RXPARS		; Change them in TCB

	MOVE T1,BFR		; What to Enqueue
	XMOVEI T2,TCBSBQ(TCB)	; Queue head for send buffers
	CALL NQ			; Enqueue it for Packetizer.

	LOAD T1,BICNT,(BFR)	; Initial count
	LOAD T2,TSBYT,(TCB)	; Currently queued for PZ
	ADD T2,T1
	STOR T2,TSBYT,(TCB)	; More...

	MOVE T1,BFRFLG(BFR)	; Get the buffer flags
	TXNN T1,TCP%UR		; URGENT send?
	  JRST SEND43		; No.
	CALL SETURP		; Yes.  Set the send urgent pointer
SEND43:

	LOAD T1,TSLFT,(TCB)	; Current Send Left
	LOAD T2,TSSEQ,(TCB)	; Current Send Sequence
	LOAD T3,TSWND,(TCB)	; Current Send Window
	ADD T3,T1		; Current Right
	MODSEQ T3
	CALL CHKWND		; See if there is space in the window
	JUMPE T1,SEND5		; Jump if not.  Recv'd ACK will restart.
	$SIGNL(PZ,0)		; Make Packetizer run now
SEND5:

	TDZA T1,T1		; Say OK to caller
SEND6:	  HRROI T1,ELP+↑D12	; "Connection Closing"
SENDX:	RET

SEND8:	HRROI T1,ELP+↑D30	; Only internet fork can run TVTs
	RET

; SETURP		Set up the send urgent pointer

; An URGENT send is being done and the value of the send urgent pointer
; must be computed.  This is done by adding up all the queued data
; (on the send buffer queue) to get the current end of the urgent data,
; relative to the current send sequence.


;TCB/	Pointer to connection block
;			NOINT
;	CALL SETRUP
;Ret+1:	Always.  TSURP setup and TSURG turned on.

SETURP:	PUSH P,BFR		; Need this global for scanning buffers
	TEMP <CNT,NXT>		; Give names to T1, T2
	MOVEI CNT,0		; Assume no partial buffer
	LOAD BFR,TSCB,(TCB)	; Get partial buffer if any
	JUMPE BFR,SETUR1	; Jump if none
	SETSEC BFR,INTSEC	; Make extended address
	LOAD CNT,BCNT,(BFR)	; Get number of unsent bytes from bfr
SETUR1:
	MOVEI NXT,TCBSBQ(BFR)	; Pointer to send buffer queue head
SETUR2:	MOVE BFR,NXT		; Point bfr to what we will process
	CAIN BFR,TCBSBQ(BFR)	; Back to the queue head
	  JRST SETUR3		; Means done.  Go finish up.
	SETSEC BFR,INTSEC	; Make extended address
	LOAD NXT,QNEXT,+TCBSBQ(TCB) ; Get pointer to next item for next time
	LOAD T3,BCNT,(BFR)	; Get count from this buffer
	ADD CNT,T3		; Add into total
	JRST SETUR2		; Loop over entire queue, incl. bfr being sent
SETUR3:
	LOAD T3,TSSEQ,(TCB)	; Next send seq. num. to be used
	ADD T1,T3		; Compute 1st non-urgent seq. num.
	MODSEQ T1		; Keep within the right number of bits
	STOR CNT,TSURP,(TCB)	; Set the urgent pointer into the TCB
	SETONE TSURG,(TCB)	; Say we are in send urgent mode
	POP P,BFR
	RESTORE
	RET

; .RECV		Receive a buffer

;T1/	Flags,,JCN (or pointer to CDB)
;T2/	Pointer to buffer header
;
;	RECV
;Ret+1:	 Error.  Code in T1
;Ret+2:	Success

.RECV::	MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,RECV1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call RECV1
	JUMPL T1,TCPERR		; Error.
	UMOVE T1,T1		; Get flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
	  SMRETN		; No.  Give immediate skip return
RECVW:	LOAD T1,BIDX,(BFR)
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,↑D18+<WID(TERRF)>	; Put indexes in LH
	HRRI T1,INTOOT		; Select RECV done test routine
	MDISMS
	JN TERR,(TCB),TCPBER	; Jump if any error posted
	JRST TCPSKP

; RECV1(TCB)		Second phase of RECV

;T1/	JCN specified by caller
;TCB/	(Extended) Locked connection block
;			NOINT
;	CALL RECV1
;Ret+1:	Always.  T1 has 0 and BFR has the buffer, or T1 has-1,,error

RECV1:	JN TTVT,(TCB),RECV8	; Not allow for TVTs
;	LOCAL <OLDWND>
	LOAD T3,TRSYN,(TCB)	; Get receive state
	CAIE T3,NOTSYN		; Not synchronized
	 CAIN T3,FINRCV		; or FIN received?
	  JRST RECV9		; Yes.  Fail. (error code into buffer?)
	SETZ T2,		; Not allow options from CDB here
	CALL ACTTCB		; Try to activate the TCB (JCN in T1)
	JUMPL T1,RECV9		; Could not.
	CALL MAKBFR		; Make a buffer descriptor
	SKIPGE BFR,T1		; Check for error
	  EXIT RECVX		; There was one.
	LOAD T1,TRBS,(TCB)	; Current amount of receive buffer space
	LOAD T2,BICNT,(BFR)	; How much more is being made available
	ADD T1,T2
	STOR T1,TRBS,(TCB)	; New amount (for window setting)
	MOVE T1,BFR		; Item to enqueue
	XMOVEI T2,TCBRBQ(TCB)	; Receive buffer queue head
	CALL NQ			; Enqueue this buffer there

;	LOAD OLDWND,TRWND,(TCB)	; Get the current (old) window
	CALL NUWNDO		; Setup the new window, maybe ENCPKT
;	STOR T1,TRWND,(TCB)	; Set into the TCB
;	JUMPN OLDWND,RECV4	; No ACK needed if not opening from 0
;	JUMPE T1,RECV4		; Must be actually opening to non-0
;	CALL FRCPKT		; Make PZ send an ACK
;RECV4:
	JN TRPP,(TCB),RECV5	; Jump if partially process pkt waiting
	LOAD T1,QNEXT,<+TCBRPQ(TCB)>	; Ptr to 1st thing on RA queue
	CAIN T1,TCBRPQ(TCB)	; Empty queue?
	  JRST RECV6		; Yes.  No use running RA
RECV5:

	JN TRCB,(TCB),RECV6	; No signal if RA already has a BFR
	LOAD T3,QNEXT,<+TCBRBQ(TCB)> ; Get next buffer on the queue
	SETSEC T3,INTSEC	; Make extended address
	CAME T3,BFR		; Will this new buffer restart RA?
	  JRST RECV6		; No.  No need to run RA
	$SIGNL(RA,0)		; Make Reassembler run now
RECV6:

REPEAT 0,<
	MOVE T1,TCPRA0		; Time to wait
	LOAD T2,TSSYN,(TCB)	; Get send state
	LOAD T3,TRSYN,(TCB)	; Get receive side state
	CAIE T2,SYNSNT		; SYN sent?
	 CAIN T2,SYNCED		; or Synchronized?
	  CAIN T3,SYNABL	; And have heard something from other end?
	   CAIA
	    CALL ENCPKT		; Announce the new window in (T1) time
> ; End of REPEAT 0

	TDZA T1,T1		; Say OK to caller
RECV9:	  HRROI T1,ELP+↑D12	; "Connection Closing"
RECVX:;	RESTORE
	RET

RECV8:	HRROI T1,ELP+↑D30	; Only internet fork can run TVTs
	RET

; .OPEN		Open a connection

;T1/	Flags,,Pointer to Connection Descriptor Block (CDB)
;T2/	Persistence, seconds (max is TCPPTM)
;T3/	RX parameters
;
;	OPEN
;Ret+1:	 Error.  T1 has <JCN,,code>.	ELP+↑D1 - bad bit (TCP%JS)
;Ret+2:	Success.

.OPEN::	MCENT			; Enter the monitor context
	TXNE T1,<STSFLG!TCP%JS>&↑-<TCP%WT> ; JCN supplied is an error
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,OPEN1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call OPEN1
	JUMPL T1,OPENE		; Jump if there was an error ?? JCN/TCB
	UMOVE T2,T1		; Get flags
	TLNE T2,(TCP%WT)	; Supposed to wait?
	  JRST OPENW		; Yes.
OPENOK:	TLO T1,(TCP%JS)		; Turn on JCN Supplied bit for him
	UMOVEM T1,T1		; Give JCN to user
	SMRETN

OPENW:	PUSH P,T1		; Save the JCN
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,↑D18+<WID(TERRF)>	; Put indexes in LH
	HRRI T1,INTOOT		; Select OPEN Done Test
	MDISMS
	POP P,T1
	LOAD T2,TERR,(TCB)	; Get error code
	JUMPE T2,OPENOK		; Jump if no error
	HRLZS T1		; JCN left half
	HRR T1,T2		; Put error code in right half
	SKIPA
OPENE:	  HRRZS T1		; ?? JCN/TCB
; Ought to get rid of JCN & TCB since returning error
	JRST TCPERO

; OPEN1(TCB)		Second phase of OPEN JSYS

;T1/	JCN resulting from CDB specified by caller
;T2/	Option addresses word, or 0 if none specified
;TCB/	(Extended) Locked connection block
;			NOINT
;	CALL OPEN1
;Ret+1:	Always.  T1 has -1,,error or the JCN
;		-1,,ELP+↑D6	Already open
;		-1,,ELP+↑D12	Closing (one side or other NOTSYN)
;		-1,,ELP+↑D30	TCP%VT not allowed by user jobs


OPEN1:	LOCAL <USRAC1,JCN,UOPTS>
	MOVEM T1,JCN
	MOVEM T2,UOPTS
	UMOVE USRAC1,T1		; Get the flags

	TLNN USRAC1,(TCP%VT)	; Virtual terminal?
	  JRST OPEN1A		; Not a virtual terminal
	HRROI T1,ELP+↑D30	; "Only Internet fork can run TVTs"
	MOVE T2,FORKX		; Which fork this is
	CAME T2,INTFRK		; The Internet fork?
	  JRST OPENX		; No.  Give error return  ?? JCN/TCB
OPEN1A:
	JN TSUOP,(TCB),OPEN6	; Jump if already open  ??? error or not???
				;		?? JCN/TCB
IFN MNET,<			; This code only if support multiple nets
	LOAD T1,TFH,(TCB)	; Get foreign host
	JUMPE T1,OPEN1D
	PUSH P,P1		; Save AC
	CALL FNDNCT		; Get the NCT for that net
	 JRST [ POP P,P1	; Restore AC
		MOVE T1,DEFADR	; Use default address
		JRST OPEN1B]	; Join below
	MOVE T1,NTLADR(P1)	; get our address on that network
	POP P,P1		; Restore AC
OPEN1B:>
IFE MNET,<MOVE T1,INETID>	; If only one name get it
	STOR T1,TLH,(TCB)	; And stick it in the TCB
OPEN1D:
	MOVE T1,JCN
	MOVE T2,UOPTS
	CALL ACTTCB		; Try to activate the TCB 
	JUMPL T1,OPENX2		; Cannot
	SETONE TSUOP,(TCB)	; Mark the TCB as open

	JE TNUFM,(TCB),OPEN5	; Skip following if old format
	HRRZ T1,USRAC1		; Connection block address
	UMOVE T1,.TCPIP(T1)	; Get IP parameter word
	STOR T1,TTOS,(TCB)	; Save type of service
	HLRS T1
	TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
	  STOR T1,TTTL,(TCB)	; Yes, Save Time to live
	LSH T1,↑D<-18+2>	; Top two bits
	STOR T1,TIFDF,(TCB)	; Don't fragment
OPEN5:
	UMOVE T2,T2		; Get the send timeout from user
	JUMPE T2,OPEN4		; Don't change if no specification
	CAMLE T2,TCPPTM		; Be sure it is reasonable for add to TODCLK
	  MOVE T2,TCPPTM
	IMULI T2,↑D1000		; Make into milliseconds
	STOR T2,TSTO,(TCB)	; Set the new value into the TCB
OPEN4:

	UMOVE T1,T3		; Get Retrans. parameter word
	CALL RXPARS		; Change them in TCB

	TLNN USRAC1,(TCP%VT)	; Openning as a virtual terminal?
	  JRST OPEN3		; No
	SETONE TTVT,(TCB)	; Yes.  Mark TCB as such
OPEN3:
	TLNE USRAC1,(TCP%FS)	; Supposed to force synchronization?
	  CALL FRCPKT		; Yes.  Packetizer will do that.
				;  Wait a sec??
; ??Why isn't TSPRS set BEFORE FRCPKT is called??
	TLNN USRAC1,(TCP%PS)	; Supposed to be persistent?
	  JRST OPEN2		; No.
	SETONE TSPRS,(TCB)	; Yes, mark the TCB as such.
OPEN2:
	MOVE T1,JCN		; Value to return
	EXIT OPENX

;OPEN12:SKIPA T1,[-1,,ELP+↑D12]	; "Connection closing"

;Returning an error is bad since connection is open & cannot return
;both error and JCN,  either abort & return error or skip & return JCN

OPEN6:	  HRROI T1,ELP+↑D6	; "Connection already open"
OPENX2:				; Probably bad options
OPENX:	RESTORE
	RET

; .CLOSE		Close a connection

;T1/	Flags,,JCN (NOTE: don't allow CDB here since it would create a TCB)
;
;	CLOSE
;Ret+1:	 Error, Code in T1
;		ELP+↑D1   Bad JCN, No TCB, CDB not allowed
;		ELP+↑D3   Was never open
;Ret+2:	Success

.CLOSE::MCENT			; Enter the monitor context
	TXNE T1,TCP%JS		; JCN must be supplied
	 TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	HRRZS T1		; Save just the JCN part
	XMOVEI T2,CLOSE1	; Select CLOSE1 routine
	CALL CHKJCN		; Check access, set TCB, call CLOSE1
	JUMPL T1,TCPERR		; Jump if error.
	UMOVE T1,T1		; Get flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
	  JRST CLOSEX		; No.  User will do ABORT to release JCN
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,↑D18+<WID(TERRF)> ; Put indexes in LH
	HRRI T1,INTZOT		; Select Close Done Test
	MDISMS
	LOAD T1,TERR,(TCB)	; Get the error code
	JUMPN T1,TCPERR		; Jump if error code non-null
	LOAD T1,TJCN,(TCB)	; Get the JCN for this connection
	CALL RETJCN		; Release it
CLOSEX:	SMRETN

; CLOSE1(TCB)		Second phase of CLOSE JSYS

;T1/	JCN Specified by caller (ignored here)
;TCB/	(Extended) Locked Connection Block
;			NOINT
;	CALL CLOSE1
;Ret+1:	Always. T1 has 0 for OK, or -1,,error
;			ELP+↑D3 Connection not open


CLOSE1::JE TSOPN,(TCB),CLOSE3	; Was it ever open?
	JE TSUOP,(TCB),CLOSE3	; Still Open?
	SETZRO TSUOP,(TCB)	; No longer
	CALL FRCPKT		; Get a FIN sent by Packetizer
	TDZA T1,T1		; Tell caller OK
CLOSE3:	  HRROI T1,ELP+↑D3	; "Connection not open"
	RET
;	RESET%
;	  V
;	CLZFF%
;	  V
;	ABTJCS
;	  V
;	ABTJC1	ABORT%
; For all JCN	  V
;	ABTJCN	ABORT1
;	  V	  V
;	ABTTCB,RETJCN

; .ABORT		Abandon this end of a connection

;T1/	Flags,,JCN
;
;	ABORT
;Ret+1:	Error.  T1 has code.	ELP+↑D1 - CDB supplied
;Ret+2:	Success.  Nothing more will be heard about this connection.

.ABORT::MCENT			; Enter monitor context
	TXNE T1,TCP%JS		; JCN must be supplied
	 TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	HRRZS T1		; Save just the JCN
	XMOVEI T2,ABORT1	; Select the routine to run
	CALL CHKJCN		; Check arguement, set TCB, run ABORT1
	JUMPL T1,TCPERR		; Jump if some sort of error
	MOVEI T1,TCPABT		; Select wait routine
	HRL T1,FORKX		; For this fork
	MDISMS
	SMRETN



; ABORT1(TCB)		Second phase of ABORT JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked Connection Block
;			NOINT
;	CALL ABORT1
;Ret+1:	Always.  T1 has 0 for passing to caller.

ABORT1:
	CALL ABTTCB		; Abort the connection and increment
				; # being aborted by this forkx
	LOAD T1,TJCN,(TCB)	; Get user's handle
	CALL RETJCN		; Release that.
	MOVX T1,OK		; Say OK to caller
	RET

; ABTJCS			Abort JCNs for forks (part of CLZFF & RESET)

;T1/	Job fork number of fork being considered
;
;	CALL ABTJCS
;Ret+1:	Always.

ABTJCS::SKIPE TCPON		; TCP enabled?
	 SKIPL TCPIFG		; TCP Initialized yet (JOB-0 startup)
	  RET			; No.
	SAVET			; CLZFF code requires this
	MOVE T3,T1		; Put in place for call via LCKCAL
	XMOVEI T1,TCBHLK	; Stabilize JCNTCB table in JSB
	XMOVEI T2,ABTJC1	; and call function to abort JCNs
	NOINT			; Retain control during this
	CALL LCKCAL
	MOVEI T1,TCPABT		; Wait for all to be aborted
	HRL T1,FORKX		; The ones by this fork, that is.
	MDISMS
	OKINT			; State is clean again
	RET


;T1/	Job fork number of fork being considered
;
; ABTJC1	Same as above, but called with TCBH Lock set, NOINT
; TCBHLK locked		NOINT

ABTJC1:	LOCAL <JCN,JOBFRK>
	PUSH P,TCB
	MOVEM T1,JOBFRK
	MOVSI JCN,-MAXJCN	; Set to scan table
ABTJC2:	HRRZ TCB,JCNTCB(JCN)	; Get pointer to TCB
	JUMPE TCB,ABTJC3	; Avoid non-pointers
	SETSEC TCB,INTSEC	; Make extended address
	XMOVEI T1,TCBLCK(TCB)	; Pointer to lock on that TCB
	XMOVEI T2,ABTJCN	; Function to abort a JCN
	MOVE T3,JOBFRK		; Argument for ABTJCN
	CALL LCKCAL		; Lock the TCB and Abort the JCN
ABTJC3:	AOBJN JCN,ABTJC2	; Loop over all
	POP P,TCB
	RESTORE
	RET

; ABTJCN(TCB)		; Abort a JCN (ie, the connection) (Part of CLZFF)

;T1/	Job fork number being considered
;TCB/	(Extended) Locked connection block
;TCBH/	Locked TCB Hash table
;			NOINT
;	CALL ABTJCN
;Ret+1:	Always.

ABTJCN:	LOAD T2,TOWNR,(TCB)	; Get job number of owner
	CAME T2,JOBNO		; Better be ours
	  TCPBUG(CHK,<ABTJCN: TCP Conn not owned by aborting job>,TCPJS4)
	LOAD T2,TOFRK,(TCB)	; Get job fork handle of owning fork

	UMOVE T3,T1		; Get CLZFF flags from caller
	CAME T1,T2		; Was JCN created by the object fork?
	  JRST ABTJC4		; No.
	TXNN T3,CZ%NSF		; Yes. Are we supposed to abort there?
	  JRST ABTJC5		; Yes.  Go do it
	EXIT ABTJCX

ABTJC4:	EXCH T1,T2		; Get to right places for SKIIFA
	TXNN T3,CZ%NIF		; Abort inferiors' connections?
	 CALL SKIIFA		; Check owner inferior to object fork
	  EXIT ABTJCX		; Should not kill it
ABTJC5:
	NOSKED
; ??Why not CALL ABORT1 for these?
	CALL ABTTCB		; Get the TCP fork to do the work
	LOAD T1,TJCN,(TCB)	; Get the JCN
	CALL RETJCN		; Release that

	OKSKED
ABTJCX:	RET

; ABTTCB(TCB)			Get the TCB aborted (by PZ or CLZFF
;						or by ABORT)

;TCB/	Locked Connection Block
;			NOINT, maybe NOSKED
;	CALL ABTTCB
;Ret+1:	Always.

ABTTCB::NOSKED
	JN TSABT,(TCB),ABTTCX	; Already being aborted?
	SETONE TSABT,(TCB)	; No.  Make it so.
	SETZRO TSUOP,(TCB)	; Fake a CLOSE
	MOVE T1,FORKX		; Our fork number
	STOR T1,TABTFX,(TCB)	; Indicate which is killing the TCB
IFKA <	CALL ABTPTR>		; Simulate ADJBP ...
IFNKA <	ADJBP T1,FKABCP>	; Pointer to base of counters
	LDB T2,T1
	CAIGE T2,<1←ABTCBS>-1	; Do not allow count to wrap around
	  ADDI T2,1		; Bump the number killed by this fork
	DPB T2,T1
	$SIGNL(PZ,0)		; Run packetizer
ABTTCX:	OKSKED			; Note: new macro should not require this
	RET

	RESCD
; TCPABT(FORKX)			Scheduler test for ABORT(s) done

;T1/	a FORKX
;T4/	Return address
;
;	JSP T4,TCPABT
;Ret+1:	 One or more connections still being aborted
;Ret+2:	All ABORTs completed


TCPABT::IFKA <CALL ABTPTR>	; Simulate ADJBP ...
	IFNKA <ADJBP T1,FKABCP>
	LDB T2,T1
	JUMPE T2,1(T4)
	JRST 0(T4)


IFKA <
; ABTPTR(Number)	Get byte ptr to Nth abort counter

;T1/	The counter index (a FORKX)
;
;	CALL ABTPTR
;Ret+1:	Always.  Pointer in T1.

ABTPTR::PUSH P,T2		; Save an AC
	IDIVI T1,<↑D36/ABTCBS>	; Divide by number of bytes/word
	ADD T1,ABTTAB(T2)	; Add word offset to pointer
	POP P,T2
	RET

	XX==ABTCBS
ABTTAB:	REPEAT <↑D36/ABTCBS>,<	POINT ABTCBS,TCPABC,<-1+XX>
				XX==XX+ABTCBS
			      >
     >
	SWAPCD

; .STAT		Get status of a connection or the TCP

;T1/	Flags,,JCN or Pointer to CDB
;T2/	-N,,Offset	Number and beginning to return
;T3/	-M,,Address	Size and location in user space for results
;
;	STAT
;Ret+1:	 Error.  Code in T1
;			ELP+↑D20
;			ELP+↑D21
;		from CHKARG
;Ret+2:	Success

.STAT::	MCENT			; Enter monitor context
	TXNE T1,<TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT!STSFLG>
	  JRST TCPILP		; Illegal control bit
	TXNE T1,TCP%ST		; Asking for TCP statistics?
	  JRST STATS		; Yes
	TXNE T1,TCP%NT		; AOBJN pointer for TVTs wanted?
	  JRST STATNT		; Yes
	TXNE T1,TCP%NI		; AOBJN pointer for connections wanted?
	  JRST STATNI		; Yes
	XMOVEI T1,STAT1		; Select routine to call
	CALL CHKARG		; Check arguments, set TCB, call STAT1
	JUMPL T1,TCPERR		; There was something wrong.
	SMRETN



; Return in 2/ -#TVTs,,first TVT

STATNT:	MOVE T2,TVTPTR		; Get AOBJN pointer
	UMOVEM T2,2		; to user
	SMRETN			; All ok



; Return in 2/ -# connections,,1

STATNI:	MOVN T2,TCBCNT		; # connections
	HRLS T2			; in LH
	HRRI T2,1		; First connection #
	UMOVEM T2,2		; to user
	SMRETN			; All ok

; Just copy the statistics area to user space

STATS:	SETZ TCB,		; Be safe
	TXNE T1,TCP%SY		; Giving symbolic names?
	  JRST STATS9		; Yes
	HLRE T1,T2		; Get count
	MOVNS T1		; As a positive number
	HLRE T4,T3		; Get size of user's area
	MOVNS T4		; As a positive number
	CAMLE T1,T4		; Take min as size of transfer
	  MOVE T1,T4
	MOVEI T4,0(T2)		; Start point
	ADD T4,T1		; End + 1
	CAILE T4,STATZZ-STAT0	; Compare with size of statistics area
	  JRST STATS8		; Tell him it is bad.
	PUSH P,T1		; Save for awhile
	MOVEI T2,STAT0(T2)	; Start address within statistics area
	HRRZS T3		; Assume user section 0
	CALL BLTMU		; Transfer from monitor to user
	POP P,T4		; Recover size
	HRLS T4			; Make N,,N
	XCTU [ADDM T4,T2]	; Update user's pointers
	XCTU [ADDM T4,T3]
	SMRETN

STATS8:	HRROI T1,ELP+↑D21	; Bad arg to STAT
	JRST TCPERR

STATS9:	CALL STATNM		; Do work
	JUMPL T1,TCPERR		; Error exit
	SMRETN

; STAT1(TCB)			Second phase of STAT JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked connection block
;			NOINT
;	CALL STAT1
;Ret+1:	Always.  T1 has 0 for OK, or -1,,error
;			-1,,ELP+↑D20
;			-1,,ELP+↑D21

STAT1:	LOCAL <XFRCNT>
	UMOVE T1,T1		; Get flags
	UMOVE T2,T2		; Get pointer
	UMOVE T3,T3		; Get pointer to user space
	TXNE T1,TCP%SY		; Giving symbolic names?
	  JRST STAT6		; Yes

	JUMPGE T2,STAT9		; Strange pointer
	JUMPGE T3,STAT9		; Strange pointer
	HLRE T1,T2		; Get count
	MOVNS T1		; As a postive number
	HLRE XFRCNT,T3		; Get size of user's area
	MOVNS XFRCNT		; As a postive number
	CAMLE XFRCNT,T1		; Take min as size of transfer
	  MOVE XFRCNT,T1
	HRRZ T4,T2		; Start offset
	CAIL T4,TCBSIZ		; Must be within TCB
	  JRST STAT8		; Tell him "bad arg"
	ADD T4,XFRCNT		; Compute end+1
	CAILE T4,TCBSIZ		; Trying to read too much?
	  JRST STAT8		; Tell him arg is bad.
	HRRZS T2		; Flush the count
	ADD T2,TCB		; Start address within TCB
	HRRZS T3		; Flush the count (assume user sec 0)
	MOVE T1,XFRCNT		; Set up count
	CALL BLTMU		; Transfer from monitor to user
	HRLS XFRCNT
	XCTU [ADDM XFRCNT,T2]	; Update user's pointers
	XCTU [ADDM XFRCNT,T3]
	MOVX T1,OK		; Tell caller all is well
	EXIT STATX

STAT6:	CALL STATNM		; Do the work
	JRST STATX

STAT8:	SKIPA T1,[-1,,ELP+↑D20]	; "Funny pointer to STAT"
STAT9:	  HRROI T1,ELP+↑D21	; "Bad transfer size to STAT"
STATX:	RESTORE
	RET
; Symbolic Routines

; T1/	User flags
; T2/	Input count/pointer
; T3/	Output count/pointer
;	CALL STATNM
;Ret+1:	Always  T1 has error code or 0

STATNM:	LOCAL <UFL,INP,OUP>
	PUSH P,TCB-1		; Used for STAT0
	XMOVEI TCB-1,STAT0	; References
	JUMPGE T2,STATNV	; IN pointer error
	JUMPGE T3,STATNV	; OUT pointer error
	MOVEM T1,UFL		; Save flags (TCP%SD)
	MOVEM T2,INP		; Save pointers
	MOVEM T3,OUP

; Know have valid input ptr & at least 1 output slot

STATN3:	UMOVE T4,(INP)		; Get name
	CALL SRCH		; Lookup name
	JUMPE T2,STATNW		; Lose
	TXNE UFL,TCP%SD		; Want pointer or value?	
	  MOVEI T2,1		; Pointer has only one value

	TXNE UFL,TCP%SD		; Want pointer or value?
	 SKIPA T1,T3		; Get pointer
	  LDB T1,T3		; Get value

STATN7:	UMOVEM T1,(OUP)		; For user
	SOS T2			; One less to go
	AOBJP OUP,STATNU	; Leave if output full
	JUMPLE T2,STATN8	; End Multiple
	ILDB T1,T3		; Get value
	JRST STATN7

STATN8:	AOBJN INP,STATN3	; More input?
	SETZ T1,		; No, All done w/o error
	JRST STATNX

STATNU:	SKIPN T1,T2		; Error if more to output
	  AOBJP INP,STATNX	; Or more input
STATNV:	SKIPA T1,[-1,,ELP+↑D21]	; Bad pointers
STATNW:	  HRROI T1,ELP+↑D22	; Invalid name

STATNX:	UMOVEM INP,2		; Return updated input
	UMOVEM OUP,3		; And output pointers
	POP P,TCB-1		; Restore register
	RESTORE
	RET			; Return

; Exact Match Binary Search Routine

; T4/	Symbol
;	CALL SRCH
; T3/	Pointer
; T2/	Count

SRCH:	TEMP <PRB,XXX,OFS,KEY>
	SETZB PRB,T2		; Offset into table & Assume missing
	MOVX OFS,1←<↑D<36-↑L<STABLN>>> ; Get Initial offset (next 2**N)
SRCHF:	ADD PRB,OFS		; Move forward (double)
SRCHR:	LSH OFS,-1		; Next time
	  SUB PRB,OFS		; Move reverse
	JUMPLE OFS,SRCHX	; Stop if no move
	CAIG PRB,STABLN		; Point too far? or
	 CAMGE KEY,STSTAB(PRB)	; Value too big?
	  JRST SRCHR		; Yes, move back
	CAML KEY,STSTAB+1(PRB)	; As far as next?
	  JRST SRCHF		; Yes, move forward
SRCHX:	CAME KEY,STSTAB(PRB)	; Exact match?
	  RET			; No, error (T2 is 0)
	MOVE T3,STATPT(PRB)	; Value
	MOVE T2,STATCT(PRB)	; Count
	RESTORE
	RET


; Symbolic STAT tables

DEFINE DEFSTS <
	XX (M,ACDLAY,HISTSZ)
	XX (M,BGRNCT)
	XX (M,BGUSE)
	XX (M,BYTRCT)
	XX (M,BYTSCT)
	XX (M,DGRNCT)
	XX (M,DGUSE)
	XX (M,DUPKCT)
	XX (M,FINRCT)
	XX (M,FINSCT)
	XX (M,INTBYP)
	XX (M,IPDLAY,HISTSZ)
	XX (M,IPPKCT)
	XX (M,IPRNCT)
	XX (M,IPUSE)
	XX (M,OHUSE)
	XX (M,OPDLAY,HISTSZ)
	XX (M,OPPKCT)
	XX (M,OPRNCT)
	XX (M,OPUSE)
	XX (M,PZDLAY,HISTSZ)
	XX (M,PZPKCT)
	XX (M,PZRNCT)
	XX (M,PZUSE)
	XX (M,RADLAY,HISTSZ)
	XX (M,RAPKCT)
	XX (M,RARNCT)
	XX (M,RAUSE)
	XX (M,RSTRCT)
	XX (M,RSTSCT)
	XX (M,RXDLAY,HISTSZ)
	XX (M,RXPKCT)
	XX (M,RXRNCT)
	XX (M,RXUSE)
	XX (M,SYNRCT)
	XX (M,SYNSCT)
	XX (T,TABTFX)
	XX (M,TASKCT)
	XX (T,TCBIO,<1←<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBIR,<1←<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBIU,<1←<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBTO,<1←<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCBTR,<1←<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCBTU,<1←<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCTBS)
	XX (T,TCTSQ)
	XX (T,TERBF)
	XX (T,TERJN)
	XX (T,TERR)
	XX (T,TERRF)
	XX (T,TERRT)
	XX (T,TFH)
	XX (T,TFP)
	XX (T,TIFDF)
	XX (T,TIPDO)
	XX (T,TIPOR)
	XX (T,TIPOU)
	XX (T,TJCN)
	XX (T,TLH)
	XX (T,TLP)
	XX (T,TMNRT)
	XX (T,TMXRT)
	XX (T,TOFRK)
	XX (T,TOPFH)
	XX (T,TOPFP)
	XX (T,TOPLH)
	XX (T,TOPNF)
	XX (T,TOWNR)
	XX (T,TPICA)
	XX (T,TPICE)
	XX (T,TPICR)
	XX (T,TPICS)
	XX (T,TPICU)
	XX (T,TPICX)
	XX (T,TPIFA)
	XX (T,TPIFE)
	XX (T,TPIFR)
	XX (T,TPIFS)
	XX (T,TPIFU)
	XX (T,TPIFX)
	XX (T,TRBS)
;	XX (T,TRCB)
	XX (T,TRCBY)
	XX (T,TRIS)
	XX (T,TRLAK)
	XX (T,TRLFT)
	XX (T,TRLWN)
;	XX (T,TRPB)
	XX (T,TRPP)
	XX (T,TRSYN)
	XX (T,TRURG)
	XX (T,TRURP)
	XX (T,TRWND)
	XX (T,TRXI)
	XX (T,TRXPD)
	XX (T,TRXPI)
	XX (T,TRXPN)
	XX (T,TSABT)
;	XX (T,TSAP)
	XX (T,TSBYT)
	XX (T,TSCB)
	XX (T,TSCR)
	XX (T,TSEP)
	XX (T,TSFP)
	XX (T,TSLFT)
	XX (T,TSLVC)
	XX (T,TSLVN)
	XX (T,TSMRT)
	XX (T,TSMXB)
	XX (T,TSMXP)
	XX (T,TSOPN)
	XX (T,TSPRS)
	XX (T,TSSEQ)
	XX (T,TSSV)
	XX (T,TSSYN)
	XX (T,TSTO)
	XX (T,TSUOP)
	XX (T,TSURG)
	XX (T,TSURP)
	XX (T,TSWND)
	XX (T,TTOS)
	XX (T,TTPDO)
	XX (T,TTPOR)
	XX (T,TTPOU)
	XX (T,TTTL)
	XX (T,TTVT)
	XX (T,TVTL)
	XX (T,TWLDN)
	XX (T,TWLDP)
	XX (T,TWLDT)
> ; End of DEFINE DEFSTS
; Construct the ASCII Name Table

DEFINE XX (TYP,NAM,LEN)<
IFLE <ASCII /NAM/>-..XL,<PRINTX ? DEFSTS NAM is truncated or out of order>
	..XL=ASCII /NAM/
	EXP ..XL
> ; End of DEFINE XX


	..XL=400000000000
STSTAB:	400000000000		; Minimum
;	DEFSTS			; Status names
	XLIST
	DEFSTS			; Status names
	LIST
	377777777777		; Maximum
STABLN=.-STSTAB-2


; Construct the Count Table

DEFINE XX (TYP,NAM,LEN)<
	IFB  <LEN>,<1>
	IFNB <LEN>,<LEN>
> ; End of DEFINE XX

STATCT:	0			; Minimum
;	DEFSTS			; Status counts
	XLIST
	DEFSTS			; Status counts
	LIST
	0			; Maximum


; Construct the LDB Pointer Table

DEFINE XLDB  (L,O,M)<	<↑D<35-POS(M)>>B5+<WID(M)>B11+<TCB>B17+O >

DEFINE XX (TYP,NAM,LEN)<
	..XL=-1
  IFIDN <TYP><M>,<			POINT 36,NAM-STAT0(TCB-1),35
		..XL=..XL+1> ; End IFIDN M
  IFIDN <TYP><T>,<	IFNDEF %'NAM,<	POINT 36,NAM(TCB),35>
			IFDEF  %'NAM,<	%'NAM (XLDB,,,NAM)>
		..XL=..XL+1> ; End IFIDN T
  IFN ..XL,<PRINTX ? Type code for NAM must be M or T>
> ; End of DEFINE XX


STATPT:	0
;	DEFSTS			; Status pointers
	XLIST
	DEFSTS			; Status pointers
	LIST
	0

	PURGE ..XL

; .CHANL		Set TCP event interrupt channels

;T1/	Flags,,JCN (or pointer to CDB)
;T2/	Six 6-bit bytes (channel numbers)
;	77 - No change, or 0-5, 24-35 Channel to get intertupt
;	CHANL
;Ret+1:	 Error, Code in T1.
;		from CHKARG
;			ELP+↑D17 Bad arg to CHANL
;Ret+2:	Success

.CHANL::MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,CHANL1	; Select routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call CHANL1
	JUMPL T1,TCPERR		; Jump if something is wrong.
	SMRETN

; CHANL1(TCB)			Second phase of CHANL JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked Connection Block
;			NOINT
;	CALL CHANL1
;Ret+1:	Always.  T1 has 0 if OK, or -1,,error
;			-1,,ELP+↑D17 Bad arg to CHANL

CHANL1:	TEMP <NEW,OLD,CNT,FORKID>
	LOCAL <NEWCHS,NEWPTR,OLDPTR,FRKPTR>
	UMOVE NEWCHS,T2		; Get channel word from user
	MOVE NEWPTR,[POINT 6,NEWCHS]	; Set to scan them
	MOVE OLDPTR,[POINT 6,TCBPIC(TCB)]; Set to scan current ones
	MOVE FRKPTR,[POINT 18,TCBPIF(TCB)]; Set to scan forks
	MOVEI CNT,6		; How many to scan
	MOVE FORKID,FORKX	; Who is setting the new channels

CHANL2:	ILDB NEW,NEWPTR		; Get a new setting
	ILDB OLD,OLDPTR		; and what was there before
	CAIE NEW,77		; No change mark?
	 CAIG NEW,5		; OK number for the channel?
	  JRST CHANL3		; Take the good number
	CAIL NEW,↑D24		; These are also OK
	 CAILE NEW,↑D35
	  JRST CHANL9		; Bad.  Tell user.
CHANL3:
	CAIE NEW,77		; No change?
	  MOVE OLD,NEW		; No.  New will replace old
	DPB OLD,NEWPTR		; Construct the replacement set
	IBP FRKPTR		; Move to current fork slot
	CAIE NEW,77		; Changing the channel
	  DPB FORKID,FRKPTR	; Yes.  This fork gets the PSIs now.
	SOJG CNT,CHANL2		; Loop over all six bytes

	MOVEM NEWCHS,TCBPIC(TCB); Stash into TCB
	TDZA T1,T1		; Tell caller all is well
CHANL9:	  HRROI T1,ELP+↑D17	; "Bad arg to CHANL"
	RESTORE
	RET

; .SCSLV	Set connection security level

;T1/	Flags,,JCN or pointer to CDB
;T2/	Security Level
;
;	SCSLV
;Ret+1:	 Error.  Code in T1
;		from CHKARG
;			ELP+↑D29 Security already set
;Ret+2:	Success.

.SCSLV::MCENT
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&↑-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,SCSLV1	; Select routine to call via CHKARG
	CALL CHKARG		; Check args, set TCB, call SCSLV1
	JUMPL T1,TCPERR		; Give error return if appropriate
	SMRETN			; Otherwise, it was good.



; SCSLV1(TCB)		Second Phase of SCSLV JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	Locked connection block
;			NOINT
;	CALL SCSLV1
;Ret+1:	Always.  T1 has 0 if OK, or -1,,error
;			-1,,ELP+↑D29 Security already set

SCSLV1:	UMOVE T2,T2		; Get arg from caller
	JN TSLVN,(TCB),SCSLVE	; Bad.  No changes allowed.
	STOR T2,TSLVN,(TCB)	; Set the new value
	TDZA T1,T1		; Get a 0 to indicate OK
SCSLVE:	  HRROI T1,ELP+↑D29	; "Can't change security levels"
	RET

; TATNVT	Part of ATNVT JSYS for TVTs, Returns to USER w/ w/o skip
;		Attach a TVT to a User TCB; Called in non-Job-0 context

;T1/	Flags+JCN
;
;	JRST TATNVT
;Ret+1:	 Failed, Error code in T1, JCN still valid
;	ATNX1	-1,,ELP+↑D1	Invalid JCN
;	ATNX2			Receive side not SYNCED
;	ATNX3			User CLOSEd/ABORTed connection
;	ATNX5			Recieve side has been used (RECVs)
;	ATNX6			Connection has been closed, or has errors
;	ATNX8			Send side not SYNCED
;	ATNX11			Send side has been used (SENDs)
;	ATNX13	-1,,ELT+↑D4	No TVTs or
;		-1,,ELT+↑D31	TCP not Initialized
;Ret+2:	Success, T1 contains TTY designator for TVT
;		 JCN has been released

;	MCENT			; Already in Monitor context
TATNVT::XCTU [HRRZ T1,1]	; Get JCN w/o flags
	TXO T1,<TCP%JS>		; Set JCN Supplied
	UMOVEM T1,1		; Put it back for CHKARG

	XMOVEI T1,TATNV1	; Routine to call
	CALL CHKARG		; Check arg, set TCB, call TATNV1
	JUMPL T1,TATNV0		; Give error return

	LOAD T1,TVTL,(TCB)	; Make TTY descriptor
	TXO T1,<.TTDES>
	UMOVEM T1,1		; Return TT Descriptor
	SMRETN			; OK (skip) return



TATNV0:	HRRZS T1		; Drop -1,, for compares
	CAIN T1,<ELP+↑D1>	; Translate TCP error code into TOPS20
	  MOVX T1,<ATNX1>
	CAIE T1,<ELT+↑D4>
	CAIN T1,<ELT+↑D31>
	  MOVX T1,<ATNX13>
	JRST TCPERR		; Return error

; TATNV1 (TCB,JCN)	; Second phase of TATNVT

; T1/	JCN supplied by caller
; TCB/	Locked connection block
;			NOINT
;	CALL TATNV1
;Ret+1:	Always. T1 has -1,,error, or TTY descriptor otherwise


TATNV1:	LOCAL <JCN>
	MOVEM T1,JCN

	MOVX T1,<-1,,ATNX2>
	LOAD T2,TRSYN,(TCB)	; Receive side SYNCED?
	CAIE T2,SYNCED
	  JRST TATNV9		; No, error

	MOVX T1,<-1,,ATNX8>
	LOAD T2,TSSYN,(TCB)	; Send side SYNCED?
	CAIE T2,SYNCED
	  JRST TATNV9		; No, error

	MOVX T1,<-1,,ATNX5>
	LOAD BFR,QNEXT,<+TCBRBQ(TCB)>
	CAIE BFR,TCBRBQ(TCB)	; Without receive buffers
	  JRST TATNV9		; Has buffer, error

	MOVX T1,<-1,,ATNX11>
	LOAD BFR,QNEXT,<+TCBSBQ(TCB)>
	CAIE BFR,TCBSBQ(TCB)	; Without send buffers
	  JRST TATNV9		; Has buffer, error

	MOVX T1,<-1,,ATNX3>
	JE TSUOP,(TCB),TATNV9	; Not OPENed by user error
	MOVX T1,<-1,,ATNX6>
	JE TSOPN,(TCB),TATNV9	; Not still OPEN error
	JN TERR,(TCB),TATNV9	; Had some error error

	HRRZ T1,TCB		; ASNTVT wants TCB &
	TXO T1,AN%NTP		; Say it will speak new Telnet
	CALL ASNTVT		; Assign a virtual terminal
	  JRST TATNV8		; Failed (no TVT available, etc)
	STOR T1,TVTL,(TCB)	; Save TTY # connection block

; Forget everything about Job which opened connection & give to Job0

	MOVE T1,JCN		; Our JCN
	CALL RETJCN		; Release PSIs & JCN
	SETZRO TOWNR,(TCB)	; Transferred to Job0
	SETONE TJCN,(TCB)	; without a JCN (hard to get to Job0 JSB)

	SETONE TTVT,(TCB)	; Say its a TVT
; T2 from ASNTVT
	CALL ULKTTY		; Block now stable
	TDZA T1,T1		; OK
TATNV8:	  MOVX T1,<-1,,ATNX13>	; Out of resources error (TVTs)
TATNV9:	RESTORE
	RET

; ACTTCB(TCB)		Activate a connection

; ACTTCB tries to move a connection from the completely unsynchronized
; (closed or brand new) state into the SYNABLE state, where it is
; able to send and/or repond to SYNs.  Activating a connection is the
; operation performed by user calls like OPEN, SEND and RECV, and make
; the connection be "alive".  If the connection is already active, this
; results in a true value.  False is return if the connection is
; partially closed -- one side or the other is NOTSYN state.


;T1/	JCN
;T2/	Option addresses word from OPEN, or 0 if otherwise
;TCB/	(Extended) Locked connection block
;			NOINT
;	CALL ACTTCB
;Ret+1:	Always.  T1 has 0 if successfully activated, error code otherwise

; **** Preserve T2 until TCPUOP

ACTTCB:	LOAD T4,TSSYN,(TCB)	; Get send state
	LOAD T3,TRSYN,(TCB)	; Get recv state
	CAIE T4,NOTSYN		; Unsynchronized?
	  JRST ACTTC7		; No.
	CAIE T3,NOTSYN
	  JRST ACTTC8		; Return FALSE

; NOTSYN-NOTSYN
	STOR T1,TJCN,(TCB)	; Indicate this TCB is owned
	MOVE T3,TCB
	HRL T3,FORKX		; Form system fork,,TCB
	MOVEM T3,JCNTCB(T1)	; Store in job private table
; **** T2 Preserved
	SKIPE T1,T2		; Option address word
	 CALL TCPUOP		; Get options from user
	  JUMPL T1,ACTTCX	; Return error code ** RETJCN too

	MOVE T2,JOBNO		; Our job number
	STOR T2,TOWNR,(TCB)	; Store this as TCB Owner
	MOVX T1,SYNABL		; SYN Ok state
	STOR T1,TSSYN,(TCB)	; Set send side
	STOR T1,TRSYN,(TCB)	; and recv side
; Clear persistent SYN flag, Clear OPEN has been done flag
; Clear "said it's open" bit, Clear ABORT requested flag
; Clear TVT flag
	SETZRO <TSPRS,TSUOP,TSOPN,TSABT,TTVT>,(TCB)
	SETZRO TVTL,(TCB)	; Clear TVT line number
	SETZRO TSCPK,(TCB)	; No partially filled packet

	MOVE T1,INTXPB		; Maximum data size for a packet
	SUBI T1,MINIHS+MINTHS	; Assuming no options & largest net
; ?? Really want to jam that much at other end immediately??
	JFCL
;	STOR T1,TSWND,(TCB)	; Is the default initial send window
	JFCL
;	ASH T1,1		; Twice the maximum packet data size
	STOR T1,TRWND,(TCB)	; is the default initial receive window.
	SETZRO TRBS,(TCB)	; No RECV buffer space yet

	HRRZ T1,FORKN		; Our Job fork number
	STOR T1,TOFRK,(TCB)	; Say who owns the TCB

	SETO T1,
	STOR T1,TPSIC,(TCB)	; No PSI Channels named yet
	STOR T1,TPIFU,(TCB)	; No INTRP fork
	STOR T1,TPIFR,(TCB)	; No RECV DONE fork
	STOR T1,TPIFS,(TCB)	; No SEND DONE fork
	STOR T1,TPIFE,(TCB)	; No ERROR fork
	STOR T1,TPIFX,(TCB)	; No STATE CHANGE fork
	STOR T1,TPIFA,(TCB)	; No EOL ACK fork

	STOR T1,TRLWN,(TCB)	; No last window seq #

	MOVE T1,TCPRX0		; Good starting point for retrans
	STOR T1,TMNRT,(TCB)	; Minimum round trip time
	STOR T1,TMXRT,(TCB)	; Maximum round trip time
	STOR T1,TRXI,(TCB)	; Current RX interval
	SETZRO <TRXPN,TRXPD,TRXPI>,(TCB) ; Clear RX parameters

	MOVX T1,OK		; General success code
	STOR T1,TERR,(TCB)	; Indicate no error on this connection
	LOAD T1,TERRF,(TCB)	; Index of the error event flag
	CALL CLRWTB		; Clear it
	JRST ACTTC9		; Return true to say it is now active

ACTTC7:	CAIN T3,NOTSYN		; Check receive side state
ACTTC8:	 HRROI T1,ELP+↑D12	; "Connection closing" error
				; (S=NOTSYN, R.ne.NOTSYN or
				;  S.ne.NOTSYN, R=NOTSYN)
ACTTC9:	  SETZ T1,		; Return OK (S.ne.NOTSYN & R.ne.NOTSYN)
ACTTCX:	RET			; Return with TCPUOP's error code

; CHKARG(FUNC)		Check arg(s) of TCP call, set up TCB,
			; call FN(JCN,user option word or 0)
;T1/	(Extended) Function address
;T2/	ARG2 for FUNC	(***** obsolete *****)
;
;	CALL CHKARG
;Ret+1:	Always.  T1 has value of FUNC(JCN,ARG).  TCB has been setup.
;		Note:  TCB is locked & NOINT during call to FUNC
;	CHKJCN	-1,,ELP+↑D1	JCN out of range, or no TCB for JCN
;	GETJCN	-1,,ELT+↑D4	No free JCN, no space for TCB
;		-1,,ELT+↑D31	TCP not initialized
;	CHKADD	...
;	function ...


CHKARG:	STACKL <<ARGBLK,CHKADW>>
	CHKADL (USR)		; LOCAL
	XMOVEI PARAMS,ARGBLK	; Set the pointer
	MOVEM T1,FN		; Save function address
;	MOVEM T2,ARG1		; OBSOLETE
	SETZM ARG1

	NOINT
	SKIPE TCPON		; TCP turned on?
	 SKIPN TCPIFG		; TCP Initialized yet?
	  JRST CHKARI		; No.
	UMOVE T1,T1		; Get user's AC1 flags
	TXNE T1,TCP%IX		; Connection # specified?
	  JRST CHKAR3		; Yes
	TXNN T1,TCP%JS		; JCN Supplied in right half?
	  JRST CHKAR1		; No.  Go translate into one

; Given JCN

	HRRZS T1		; Save JCN part
	MOVE T2,FN		; Function to call if JCN ok
	MOVE T3,ARG1		; Argument to FN
	CALL CHKJCN		; Set TCB, Lock it & call FN
	EXIT CHKARX		; Return whatever result
; Given Connection block or TVT number

CHKAR1:	TXNE T1,TCP%TV		; TVT number specified?
	  JRST CHKAR2		; Yes

; Given Connection block
;	SETZM JCN		; No resources reserved
	CALL GETJCN		; Reserve a JCN
	JUMPL T1,CHKARX		; Couldn't.  Tell caller
	MOVEM T1,JCN		; Save the JCN

	XCTU [HRRZ USR,T1]	; Get ptr to Connection Descriptor Blk
	UMOVE T1,.TCPLH(USR)
	UMOVE T2,.TCPLP(USR)	; Copy the info from user area
	UMOVE T3,.TCPFH(USR)
	UMOVE T4,.TCPFP(USR)
	UMOVE USR,.TCPOP(USR)
; ****	Beginning of Compatability Kludge
	PUSH P,BHC+1		; Assume new format
	JUMPE T1,KLUDG0	; If first word 0, must be new (LP=0 illegal)
	TLNE T1,-1	; If first word is LP, then only rh 16 bits used
	  JRST KLUDG0		; New format
	MOVE T4,T3		; Map old format into new
	MOVE T3,T2
	MOVE T2,T1
	SETZB T1,USR		; New info zero if old format
	SETZM (P)		; Use old format
KLUDG0:
; ****	End of Compatability Kludge
	ANDX T1,.RTJST(-1,PISH)
	ANDX T2,.RTJST(-1,PSP)
	ANDX T3,.RTJST(-1,PIDH)
	ANDX T4,.RTJST(-1,PDP)
	MOVEM T1,LH
	MOVEM T2,LP		; Store into ARGBLK for CHKADD
	MOVEM T3,FH
	MOVEM T4,FP
	MOVEM USR,ARG1		; Option addresses is second arg for FN
	SETZM WILDOK		; Not OK to find listening connections
	MOVE T1,PARAMS		; Pointer to parameter block for CHKADD
	CALL CHKADD		; Find TCB, Lock it, Call FN
; ****	Beginning of Compatability Kludge
	POP P,T2		; Old (0)/New (1) flag
	JUMPL T1,CHKA19		; Jump if all went well
	STOR T2,TNUFM,(TCB)	; Save format flag
	JRST CHKARX
; ****	End of Compatability Kludge

CHKA19:	PUSH P,T1		; Save error result
	MOVE T1,JCN		; Get back the JCN
	CALL RETJCN		; To return & disown TCB ("DEAD")
	POP P,T1		; Restore error code
	EXIT CHKARX

; Given TVT #

CHKAR2:	MOVEI T2,(T1)		; TVT line # into 2

	CALL CHKTVT		; Check if valid TVT
	  JRST CHKART		; Lose

	CALL TVTCHK		; Get (locked) data base
	  JRST CHKARU		; Not fully active
	LOAD TCB,PTVT,(T2)	; Get TCB address
	CALL ULKTTY		; Unlock TTY data base

	JUMPE TCB,CHKART	; Illegal connection
	SETSEC TCB,INTSEC	; TCBs in this section
	MOVX T3,0 ;T1		; Unused Arg for FN is line type??
	XMOVEI T1,TCBLCK(TCB)	; Lock to lock
	MOVE T4,ARG1		; Second arg for FN
	MOVE T2,FN		; Function to call
	CALL LCKCAL
	JRST CHKARX		; Leave

; Find the nth connection specified by T1

CHKAR3:	HRRZS T1		; Just the number
	CAILE T1,0		; Must be greater than 0 and
	 CAMLE T1,TCBCNT	; Less than current number
	  JRST CHKART		; Lose, invalid index
	MOVEM T1,JCN		; Save index
	XMOVEI T1,TCBHLK	; Lock for TCB hash table
	CALL SETLCK		; Lock it
	PUSH P,TCB		; Save TCB

	MOVSI T2,-TCBHSZ	; Size of hash table
CHKA30:	HRRZ TCB,T2		; Current TCBH slot
	ADD TCB,TCBH		; Add base of table (including section)
	HRRZ T3,TCB		; Save head of list
CHKA31:	LOAD TCB,QNEXT,(TCB)	; Get next on list
	CAMN TCB,T3		; Back to head?
	  JRST [AOBJN T2,CHKA30	; Yes, jump back if another slot
		SETZ TCB,	; No more, TCB not found
		JRST CHKA32]	; Quit
	SETSEC TCB,INTSEC	; TCBs in this section
	SOSE JCN		; Count down index
	  JRST CHKA31		; Loop if not want this one

; TCB points to TCB or is 0

CHKA32:	AOS TCBHUC		; Bump hash table use count
	XMOVEI T1,TCBHLK	; TCBH lock
	CALL UNLCK		; Unlock it with non-zero count means reading
;	SETZM JCN		; No resource to release
	HRROI T1,<ELP+↑D1>	; Assume error
	SKIPN TCB		; Find a TCB?
	  JRST CHKA33		; No
	XMOVEI T1,TCBLCK(TCB)	; TCB to lock
	MOVE T2,FN		; Function to call
	MOVX T3,0 ;JCN		; Restore args (JCN=0 here)
	MOVE T4,ARG1
	CALL LCKCAL		; Call function
CHKA33:	SOS TCBHUC		; Done reading TCB
	POP P,TCB		; Restore register
	JRST CHKARX		; Leave, error code in T1


CHKARU:	CALL ULKTTY		; Maybe a non-standard block
CHKART:	HRROI T1,ELP+↑D1	; Illegal connection
	JRST CHKARX

CHKARI:	HRROI T1,ELT+↑D31	; "TCP Not initialized yet"

CHKARX:	OKINT
	CHKADR
	RET

; CHKJCN(JCN)			See if caller has access to JCN

;T1/	JCN in question
;T2/	(Extended) Function to call if OK
;T3/	Argument for function
;			Maybe NOINT
;	CALL CHKJCN
;Ret+1:	Always.  T1 has -1,,error or value of FN(JCN,ARG1)
;			-1,,ELP+↑D1  Invalid JCN, No TCB

CHKJCN::PUSH P,T1		; Save the JCN
	CAIL T1,1		; Reasonable number?
	 CAIL T1,MAXJCN
	  JRST CHKJC9		; No.  Tell Caller
	HRRZ TCB,JCNTCB(T1)	; Get the TCB
	JUMPE TCB,CHKJC9	; Non-JCN, give error
	SETSEC TCB,INTSEC
CHKJC1:	LOAD T1,TOWNR,(TCB)
	CAME T1,JOBNO
	  TCPBUG(CHK,<CHKJCN: TCB ownership screwed up>,TCPJS3)
	XMOVEI T1,TCBLCK(TCB)	; Pointer to the connection lock
	MOVE T4,T3		; Put arg in right place
	MOVE T3,0(P)		; Get the JCN as first ARG to function
	CALL LCKCAL		; Lock the lock and call the function
	CAIA			; Use whatever value is returned
CHKJC9:	  HRROI T1,ELP+↑D1	; "Illegal Connection"
	SUB P,BHC+1
	RET



; GETJCN			Assign a Job Connection Number
;			NOINT
;	CALL GETJCN
;Ret+1:	Always.  T1 has the JCN (.GT.0) or -1,,ELT+↑D4

GETJCN::NOSKED			; Prevent others from interfering
	MOVSI T2,-MAXJCN+1	; Max number of JCNs per job (ignore 0)
	SKIPE JCNTCB+1(T2)	; Empty slot?
	  AOBJN T2,.-1		; No.  Check next
	HRROI T1,ELT+↑D4	; "No space for another connection"
	JUMPGE T2,GETJCX	; Return that if no empty slot found
	MOVE T3,FORKX		; Our identity.
	HRLZM T3,JCNTCB+1(T2)	; Reserve the slot for later use
	MOVEI T1,1(T2)		; The JCN as a result.
GETJCX:	OKSKED
	RET

; RETJCN(JCN)			Free a Job Connection Number

;T1/	JCN
;			NOINT
;	CALL RETJCN		; NB T2 preserved
;Ret+1:	Always.

RETJCN::PUSH P,TCB		; Save so we can use this AC
	NOSKED
	CAIN T1,-1		; Job0 w/o JCN?
	  JRST RETJCX		; Yes, special User TVT connection
	CAIL T1,1
	 CAIL T1,MAXJCN		; Reasonable number
	  CAIA
	   JRST RETJC1
	TCPBUG(INF,<RETJCN: JCN out of range>,TCPJS1)
	JRST RETJCX

RETJC1:	SETZ TCB,
	EXCH TCB,JCNTCB(T1)
	TRNN TCB,-1		; Just a reserved slot?
	  JRST RETJCX		; Yes.  Get out.
	SETSEC TCB,INTSEC	; Make extended address
	MOVNI T3,1
	STOR T3,TPSIC,(TCB)	; Disable all PSIs
	STOR T3,TPIFU,(TCB)	; Remove forks from TCB
	STOR T3,TPIFR,(TCB)
	STOR T3,TPIFS,(TCB)
	STOR T3,TPIFE,(TCB)
	STOR T3,TPIFX,(TCB)
	STOR T3,TPIFA,(TCB)
	STOR T3,TOFRK,(TCB)	; Forget owning fork
	SETZRO TJCN,(TCB)	; Disown the TCB ("DEAD")
RETJCX:	OKSKED
	POP P,TCB
	RET

; MAKBFR		Make a buffer descriptor block

; Buffer descriptors ("Buffers") are the items which get queued for the
; Packetizer and Reassembler.  There is one for each SEND or RECV
; executed by the user.  Amoung other things, a buffer block contains
; an "index" which associates that buffer with a particular DONE bit
; which is stored in resident core; it is this bit that the scheduler
; tests to reactivate a process which is waiting for that particular
; buffer.

;TCB/	(ext) pointer to locked connection block
;
;	CALL MAKBFR
;Ret+1:	Always.  T1 has the buffer address (.GT.0) or -1,,error
;		-1,,ELP+↑D15  Count < 0, Adr last word >= 1,,0
;		-1,,ELT+↑D16  No WAIT bits, No memory for BFR HDR

MAKBFR:	STACKL <DATADR>
	LOCAL <HDRADR,FLAGS,COUNT,JCNFLG>
	PUSH P,BFR
	UMOVE JCNFLG,T1		; Get JCN control flags from user
	UMOVE HDRADR,T2		; Get address of header from user
	SUBI HDRADR,BFRSUI	; Make it into standard header ptr.
	MOVSI FLAGS,(TCP%DN!TCP%ER)	; Done and Error bits
	XCTU [ANDCAB FLAGS,BFRFLG(HDRADR)] ; Clear in user space, get others
	TXNE FLAGS,TCP%UR	; Urgent (send) bit on?
	  TXO FLAGS,TCP%PU	; Yes.  That implies a PUSH.
	UMOVE T3,BFRDAD(HDRADR); Address of data area
	MOVEM T3,DATADR
	UMOVE COUNT,BFRCNT(HDRADR); Number of words/bytes in buffer
	JUMPL COUNT,MAKBF9	; Illegal
; ?? Is this used??
	MOVE T1,DATADR
	LSH T1,-PGSFT		; First page of buffer

	MOVE T2,DATADR
	MOVE T3,COUNT
	TLNE JCNFLG,(TCP%WM)	; Count is words?
	  JRST MAKBF1		; Yes.
	ADDI T3,3		; Round up to word boundary
	ASH T3,-2		; Number of words in the buffer
MAKBF1:
	ADD T2,T3
	SUBI T2,1		; Last word in buffer
	LSH T2,-PGSFT		; Last page in buffer
	CAIL T2,1000		; Better fit in memory
	  JRST MAKBF9		; Give error

	TLNN JCNFLG,(TCP%WT)	; Will this fork wait for this buffer?
	 TDZA T1,T1		; No.  No wait bit index assigned
	  CALL ASNWTB		; Assign an index
	JUMPL T1,MAKBFX		; None available right now ??? error code?
	PUSH P,T1		; Save for a while
	SKIPE T1		; No bit to clear
	  CALL CLRWTB		; Clr it to make us hang at SENDW (e.g.)
	MOVEI T1,BFRSIZ		; Size of a buffer descriptor
	CALL GETBLK		; Get a block of free storage
	SKIPG BFR,T1		; Got it? ??? error code?
	  JRST MAKBF8		; No.  Release index and return ELT+↑D16
	SETZM BFRQ(BFR)		; Indicate buffer is not on a queue
	POP P,T1		; Get back the index
	STOR T1,BIDX,(BFR)	; Put in wait bit index
	STOR TCB,BTCB,(BFR)	; Remember which TCB owns the buffer

	MOVEM FLAGS,BFRFLG(BFR)	; Store in monitor copy
	SETZRO BPTR,(BFR)	; Clear Index and Indirect fields
	MOVX T1,↑D8		; Assume byte-send
	TLNE FLAGS,(TCP%WM)	; Word mode?
	  MOVX T1,↑D36		; Yes.  Byte size is 36
	STOR T1,BPTRS,(BFR)	; Set into size field of byte pointer
	MOVE T1,TODCLK		; Now in milliseconds
	STOR T1,BTS,(BFR)	; Set into buffer timestamp
	STOR COUNT,BICNT,(BFR)	; Remember the initial count
	STOR HDRADR,BHADR,(BFR)	; and header address in user space
	MOVE T3,DATADR		; Get the user's data address
	STOR T3,BDADR,(BFR)	; Remember it
	UMOVE T1,BFROPT(HDRADR)	; Get option addresses word
; ****	Beginning of Compatability Kludge
	OPSTR SKIPN,TNUFM,(TCB)	; Using new formats?
	  SETZ T1,		; No, garbage
; ****	End of Compatability Kludge
	MOVEM T1,BFROPT(BFR)	; Save them
	MOVX T1,-1		; "Not mapped" indication
	STOR T1,BMPAG,(BFR)	; In the monitor window page number
	CALL RSTBFR		; Reset the buffer state
	MOVE T1,FORKX		; Our own System Fork Number
	STOR T1,BFRKX,(BFR)	; Remember for mapping user space
	HLRZ T1,FKPGS(T1)	; Our own UPT
	PUSH P,Q1		; Protect critical AC
	CALL UPSHR		; Keep UPT from going away
	POP P,Q1
	MOVE T1,BFR		; This is the value
	JRST MAKBFX

; No space for buffer
MAKBF8:	POP P,T1		; Get back index
; skipe t1??
	TLNE JCNFLG,(TCP%WT)	; Did we assign one?
	  CALL RELWTB		; Release it
	SKIPA T1,[-1,,ELT+↑D16]	; "No space right now"
MAKBF9:	  HRROI T1,ELP+↑D15	; "Bad buffer arg(s)"
MAKBFX:	POP P,BFR
	RESTORE
	RET

; FREBFR(BFR)		Release resources used by a buffer

;			Called by a process doing a SEND, RECV
;			which waits for completion.  In this case USRBFE
;			(or USRBFF) places the complete buffer on the
;			TCPBDQ so it may be release by this routine in
;			the above JSYSs or by ABORT.

;BFR/	(Extended) Buffer
;
;	CALL FREBFR
;Ret+1:	Always

FREBFR:	NOSKED
	LOAD T1,BIDX,(BFR)	; Get the wait bit index
	SETZRO BIDX,(BFR)	; Indicate it has been released
	SKIPE T1		; Have a bit to release?
	  CALL RELWTB		; Actually release it
	MOVE T1,BFR		; Item to dequeue
	SKIPE (T1)		; If not queued, skip it
	  CALL DQ		; Remove it from the done queue
	OKSKED
	CALLRET RETBLK		; Release the storage



	TNXEND